home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tix8.1 / FileUtil.tcl < prev    next >
Text File  |  2001-11-03  |  2KB  |  98 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: FileUtil.tcl,v 1.1.1.1.2.1 2001/11/03 06:43:50 idiscovery Exp $
  4. #
  5. # FileUtil.tcl ---
  6. #
  7. #
  8. #    Utility functions for filename handling.
  9. #
  10. # Copyright (c) 1993-1999 Ioi Kim Lam.
  11. # Copyright (c) 2000-2001 Tix Project Group.
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16.  
  17. proc tixResolveDir {dir} {
  18.     set dir [tixFile tildesubst $dir]
  19.     set dir [tixFile trimslash $dir]
  20.     
  21.     if {$dir == "/"} {
  22.     return $dir
  23.     }
  24.  
  25.     if {[string index $dir 0] != "/"} {
  26.     # Isn't an absolute path
  27.     #
  28.     set appPWD [pwd]
  29.     catch {
  30.         cd $dir
  31.         set dir [pwd]
  32.     }
  33.     cd $appPWD
  34.     return $dir
  35.     }
  36.  
  37.     set names [split $dir "/"]
  38.  
  39.     # Get rid of all "."
  40.     set n /
  41.     foreach name [lrange $names 1 end] {
  42.     if {[string compare "." $name]} {
  43.         lappend n $name
  44.     }
  45.     }
  46.     if {$n == "/"} {
  47.     return /
  48.     }
  49.  
  50.     # Get rid of all ".."
  51.     #
  52.     set list [tixCompressDotDot $n 0]
  53.  
  54.     if {$list == "/"} {
  55.     return /
  56.     }
  57.  
  58.     # General case
  59.     #
  60.     set dir ""
  61.     foreach sub [lrange $list 1 end] {
  62.     append dir /$sub
  63.     }
  64.     return $dir
  65. }
  66.  
  67. proc tixCompressDotDot {list i} {
  68.     set done 0
  69.  
  70.     while {1} {
  71.     if {$i >= [llength $list]} {
  72.         return $list
  73.     }
  74.  
  75.     if {[lindex $list $i] != ".."} {
  76.         incr i
  77.         continue
  78.     }
  79.  
  80.     # We encounter a ".."
  81.     #
  82.     if {$i == 0} {
  83.         # Can't handle this
  84.         #
  85.         return ""
  86.     }
  87.     if {$i == 1} {
  88.         set l [lindex $list 0]
  89.         set list [concat $l [lrange $list 2 end]]
  90.         continue
  91.     }
  92.  
  93.     set l [lrange $list 0 [expr $i-2]]
  94.     set list [concat $l [lrange $list [expr $i+1] end]]
  95.     incr i -1
  96.     }
  97. }
  98.